AdjustPT Subroutine

public subroutine AdjustPT(fv, domain, pt, dtpet)

Subroutine to adjust the actual evaporation to the intercepted rainfall. The amount of water intercepted by the canopy is going to contribute to the evaporation rate. When calculating the evaporation within a forest, the model tends to remove as much as possible from the water intercepted by the canopy. This step will be carried out before the adjustement of the evapotranspiration to soil moisture.

Arguments

Type IntentOptional Attributes Name
type(grid_real), intent(in) :: fv

fraction of vegetation covering the cell
type(grid_integer), intent(in) :: domain

analysis domain
type(grid_real), intent(inout) :: pt

potential transpiration from soil [m/s]

integer(kind=short), intent(in) :: dtpet

dt of evapotranspiration computation

Variables

Type Visibility Attributes Name Initial
integer(kind=short), public :: i

Taking into consideration the amount of the evapotranspiration, that the amount of water is going to evaporate first from the intercepted water, the remaining evaporative demand is going to evaporate from the soil (like the normal calculation that is usually implemented for the evapotranspiration).
integer(kind=short), public :: j

Taking into consideration the amount of the evapotranspiration, that the amount of water is going to evaporate first from the intercepted water, the remaining evaporative demand is going to evaporate from the soil (like the normal calculation that is usually implemented for the evapotranspiration).
real(kind=float), public :: ptdtcanopy

potential transpiration amount in the given dt of canopy (mm)
real(kind=float), public :: ptdtpet

potential transpiration amount in the given dt of PET (mm)

Source Code

SUBROUTINE AdjustPT  &
!
(fv, domain, pt, dtpet)

   
IMPLICIT NONE 

!Arguments with intent(in)
TYPE (grid_real), INTENT(IN) :: fv !!fraction of vegetation covering the cell
TYPE (grid_integer), INTENT(IN) :: domain !!analysis domain
INTEGER (KIND = short), INTENT(IN) :: dtpet !! dt of evapotranspiration computation

!Arguments with intent inout
TYPE (grid_real),  INTENT(INOUT) ::  pt !!potential transpiration  from soil [m/s] 


!local declarations:
REAL (KIND = float) :: ptdtpet !!potential transpiration amount in the given dt of PET (mm)
REAL (KIND = float) :: ptdtcanopy !!potential transpiration amount in the given dt of canopy (mm)
INTEGER (KIND = short) :: i, j
!REAL (KIND = float) :: Evapintercept !! amount of water evaporated from canopy storage
!REAL (KIND = float)  ::  petadj !potential evapotranspiration  [m/s]
!-------------------------end of declarations----------------------------------




!      petadj = pet - CANOPIN
!      if (petadj < 0.) then
!        CANOPIN = -petadj
!        Evapintercept = pet                                                                                                                                                  
!        petadj = 0.
!      
!      else
!       Evapintercept = CANOPIN
!        CANOPIN = 0.
!      endif
!
!pet= petadj
    
!!Taking into consideration the amount of the evapotranspiration, that the amount of water is going to evaporate first from the intercepted water,
!!the remaining evaporative demand is going to evaporate from the soil 
!!(like the normal calculation that is usually implemented for the evapotranspiration).

DO j = 1, domain % jdim
    DO i = 1, domain % idim
        IF (domain % mat (i,j) /= domain % nodata ) THEN
            
            IF (canopyStorage % mat (i,j) <= 0.) THEN !no water stored on canopy:  canopyPT = 0
                canopyPT % mat (i,j) =  0.
                CYCLE !go to next cell
            END IF
             
            !compute amount of potential transpiration of the given dt in mm
            ptdtcanopy = pt % mat (i,j) * dtCanopyInterception * 1000.
            ptdtpet    = pt % mat (i,j) * dtpet * 1000.
            
            IF ( ptdtcanopy <= canopyStorage % mat (i,j) ) THEN !canopy storage satisfies the transpiration demand
                canopyStorage % mat (i,j) = canopyStorage % mat (i,j) - ptdtcanopy !remove transpiration from canopy storage
                canopyPT % mat (i,j) =  pt % mat (i,j) !evaporation from canopy is at potential rate
                pt % mat (i,j) =  ( ptdtpet - ptdtcanopy ) / dtpet * millimeter !remove canopy evaporation  from total evaporaion
                
            ELSE !canopy storage satisfies partially the transpiration demand
                canopyPT % mat (i,j) = canopyStorage % mat (i,j) / dtCanopyInterception * millimeter
                
                pt % mat (i,j) =  ( ptdtpet - canopyStorage % mat (i,j) ) / dtpet * millimeter !remove canopy evaporation  from total evaporaion
                
                
                !pt % mat (i,j) = pt % mat (i,j) - canopyStorage % mat (i,j) / dtCanopyInterception * millimeter * &
                 !                                dtCanopyInterception/dtpet!reduce potential trasnpiration from soil
                canopyStorage % mat (i,j) = 0.
            END IF
           
        END IF
   END DO
END DO        
    
RETURN


END SUBROUTINE  AdjustPT